Syntax24.Scn.Fnt
Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
(* Notify Ralf for maintenance of Non-FPU source *)
MODULE Colors; (** ww 23 Jan 91 / RC 28.10.93**)
  IMPORT Amiga, Display, Texts, TextFrames, Viewers, MenuViewers, Oberon, Input, Files;
  CONST Menu = "System.Close  System.Copy  System.Grow";
    (*Cols = 16;  (* Number of Colors to be represented *)*)
    MaxInt = 255;  (* maximum value for intensity *)
    Left = 2; Middle = 1; Right = 0;  (* mouse buttons *)
    Comp = 3; H = 0; L = 1; S = 2;  R = 0; G = 1; B = 2;  (* Just for clarifying some things later ... *)
(* Colors 1 .. 3 are supposed to represent red green and blue. They are not editable with this tool. *)
  TYPE
    Frame = POINTER TO FrameDesc;
    FrameDesc = RECORD(Display.FrameDesc)
      beg: ARRAY 256 OF INTEGER;
      n: INTEGER
    END;
    Components = ARRAY Comp OF REAL;
    Color = RECORD
      rgb, hls: Components;
      nr: INTEGER
    END;
    EditFrame = POINTER TO EditFrameDesc;
    EditFrameDesc = RECORD(Display.FrameDesc)
      beg: ARRAY Comp + 1 OF INTEGER;
      col: Color;
      rgb: BOOLEAN
    END;
    Msg = RECORD(Display.FrameMsg) END;
  VAR w: Texts.Writer; task: Oberon.Task; grey: ARRAY 3 OF Display.Pattern; Cols:INTEGER;
  PROCEDURE UpdateRGB(VAR col: Color);
    VAR c: REAL; i: INTEGER;
  BEGIN i := 0;
    REPEAT c := col.hls[H] + (i + 2) / 3;
      WHILE c > 1 DO c := c - 1 END;
      IF c < 1/3 THEN col.rgb[i] := (1 - col.hls[S]) * col.hls[L]
      ELSIF c <= 1/2 THEN col.rgb[i] := (1 - col.hls[S] + (c - 1 / 3) * 6 * col.hls[S]) * col.hls[L]
      ELSIF c <= 5/6 THEN col.rgb[i] := col.hls[L]
      ELSE col.rgb[i] := (1 - col.hls[S] + (1 - c) * 6 * col.hls[S]) * col.hls[L]
      END;
      INC(i)
    UNTIL i = Comp
  END UpdateRGB;
  PROCEDURE UpdateHLS(VAR col: Color);
    VAR max, min: REAL;
    PROCEDURE Max(x, y: REAL): REAL;
    BEGIN
      IF x > y THEN RETURN x ELSE RETURN y END
    END Max;
  BEGIN max := Max(col.rgb[R], Max(col.rgb[G], col.rgb[B])); min := -Max(-col.rgb[R], Max(-col.rgb[G], -col.rgb[B]));
    col.hls[H] := 0; col.hls[L] := max; col.hls[S] := 0;
    IF max > 0 THEN col.hls[S] := (max - min) / max;
      IF col.hls[S] > 0 THEN col.hls[H] := (max - 2 * min + col.rgb[B] - col.rgb[R] + col.rgb[G]) / (6 * (max -min));
        IF (col.rgb[G] = max) OR (col.rgb[B] = min) THEN col.hls[H] := 1 - col.hls[H] END
      END
    END
  END UpdateHLS;
  PROCEDURE Int(v: REAL): INTEGER;
  BEGIN RETURN SHORT(ENTIER(MaxInt * v))
  END Int;
  PROCEDURE UpdateDisp(VAR col: Color);
  BEGIN Display.SetColor(col.nr, Int(col.rgb[0]), Int(col.rgb[1]), Int(col.rgb[2]))
  END UpdateDisp;
  PROCEDURE Change(VAR col: Color): BOOLEAN;
    VAR d: ARRAY Comp OF INTEGER;  v: REAL; i: INTEGER; change: BOOLEAN;
  BEGIN Display.GetColor(col.nr, d[0], d[1], d[2]); i := 0; change := FALSE;
    WHILE i < Comp DO v := Int(col.rgb[i]);
      IF v # d[i] THEN change := TRUE; col.rgb[i] := d[i] / MaxInt END;
      INC(i)
    END;
    IF change THEN UpdateHLS(col) END;
    RETURN change
  END Change;
  PROCEDURE ShowRGB(f: EditFrame);
    VAR x, w, r, i, h: INTEGER;
  BEGIN w := f.W DIV (Comp + 1) + 1; r := f.W - w * (Comp + 1); i := 0; x := 0; f.beg[i] := x; Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
    WHILE i < Comp DO h := SHORT(ENTIER(f.H * f.col.rgb[i])); DEC(r);
      IF r = 0 THEN DEC(w) END;
      Display.ReplConst(i + 1, f.X + x, f.Y, w, h, Display.replace);
      Display.ReplConst(Display.black, f.X + x, f.Y + h, w, f.H - h, Display.replace);
      INC(x, w); INC(i); f.beg[i] := x
    END;
    Display.ReplConst(f.col.nr, f.X + x, f.Y, f.W - x, f.H, Display.replace)
  END ShowRGB;
  PROCEDURE ShowHLS(f: EditFrame);
    VAR x, w, r, i, h: INTEGER;
  BEGIN w := f.W DIV (Comp + 1); r := f.W - w * (Comp + 1); i := 0; x := 0; INC(w); f.beg[i] := x; Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
    WHILE i < Comp DO h := SHORT(ENTIER(f.H * f.col.hls[i]));
      IF r = 0 THEN DEC(w) END;
      Display.ReplPattern(Display.white, grey[(i MOD 2) * 2], f.X + x, f.Y, w, h, Display.replace);
      Display.ReplConst(Display.black, f.X + x, f.Y + h, w, f.H - h, Display.replace);
      INC(x, w); INC(i); f.beg[i] := x; DEC(r)
    END;
    Display.ReplConst(f.col.nr, f.X + x, f.Y, f.W - x, f.H, Display.replace)
  END ShowHLS;
  PROCEDURE EditRGB(f: EditFrame; x, y: INTEGER; keys: SET);
    VAR backUp: Color; m: Msg;  keySum: SET; last: REAL; i: INTEGER;
  BEGIN keySum := keys; x := x - f.X; i := 1; backUp := f.col;
    WHILE (i <= Comp) & (f.beg[i] < x) DO INC(i) END;
    IF i <= Comp THEN DEC(i); last := -1;
      REPEAT Input.Mouse(keys, x, y); keySum := keySum + keys;
        Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, x, y); y := y - f.Y;
        IF y < 0 THEN y := 0 ELSIF y > f.H THEN y := f.H END;
        f.col.rgb[i] := y / f.H;
        IF f.col.rgb[i] # last THEN UpdateHLS(f.col); UpdateDisp(f.col); last := f.col.rgb[i];
          Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
          Display.ReplConst(i + 1, f.X + f.beg[i], f.Y, f.beg[i + 1] - f.beg[i] , y, Display.replace);
          Display.ReplConst(Display.black, f.X + f.beg[i], f.Y + y, f.beg[i + 1] - f.beg[i] , f.H - y, Display.replace);
          Viewers.Broadcast(m)
        END
      UNTIL keys = {};
      IF (keySum # {Left}) OR (f.col.nr > 0) & (f.col.nr < 4) THEN f.col := backUp; UpdateDisp(backUp); ShowRGB(f) END
    END
  END EditRGB;
  PROCEDURE EditHLS(f: EditFrame; x, y: INTEGER; keys: SET);
    VAR backUp: Color; m: Msg;  keySum: SET; last: REAL; i: INTEGER;
  BEGIN keySum := keys; x := x - f.X; i := 1; backUp := f.col;
    WHILE (i <= Comp) & (f.beg[i] < x) DO INC(i) END;
    IF i <= Comp THEN DEC(i); last := -1;
      REPEAT Input.Mouse(keys, x, y); keySum := keySum + keys;
        Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, x, y); y := y - f.Y;
        IF y < 0 THEN y := 0 ELSIF y > f.H THEN y := f.H END;
        f.col.hls[i] := y / f.H;
        IF f.col.hls[i] # last THEN UpdateRGB(f.col); UpdateDisp(f.col); last := f.col.hls[i];
          Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
          Display.ReplPattern(Display.white, grey[(i MOD 2) * 2], f.X + f.beg[i], f.Y, f.beg[i + 1] - f.beg[i] , y, Display.replace);
          Display.ReplConst(Display.black, f.X + f.beg[i], f.Y + y, f.beg[i + 1] - f.beg[i] , f.H - y, Display.replace);
          Viewers.Broadcast(m)
        END
      UNTIL keys = {};
      IF (keySum # {Left}) OR (f.col.nr > 0) & (f.col.nr < 4) THEN f.col := backUp; UpdateDisp(backUp); ShowHLS(f) END
    END
  END EditHLS;
  PROCEDURE HandleEdit(f: Display.Frame; VAR m: Display.FrameMsg);
    VAR frame: EditFrame;
  BEGIN
    WITH f: EditFrame DO
      IF m IS Oberon.InputMsg THEN
        WITH m: Oberon.InputMsg DO
          IF m.id = Oberon.track THEN
            IF m.keys = {} THEN Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, m.X, m.Y)
            ELSIF f.rgb THEN EditRGB(f, m.X, m.Y, m.keys)
            ELSE EditHLS(f, m.X, m.Y, m.keys)
            END
          END
        END
      ELSIF (m IS Msg) & Change(f.col) THEN
        IF f.rgb THEN ShowRGB(f) ELSE ShowHLS(f) END
      ELSIF m IS Oberon.CopyMsg THEN NEW(frame); frame^ := f^; m(Oberon.CopyMsg).F := frame
      ELSIF m IS MenuViewers.ModifyMsg THEN
        WITH m: MenuViewers.ModifyMsg DO f.Y := m.Y; f.H := m.H;
          IF f.rgb THEN ShowRGB(f) ELSE ShowHLS(f) END
        END
      END
    END
  END HandleEdit;
  PROCEDURE EditColor(colNr: INTEGER; rgb: BOOLEAN);
    VAR f: EditFrame;  v: Viewers.Viewer;  col: Color;  x, y: INTEGER; dummy: BOOLEAN;
  BEGIN col.nr := colNr; (* col.rgb[0] := -1; col.rgb[1] := -1; col.rgb[2] := -1; *) dummy := Change(col);	(* << RC *)
    NEW(f); f.col := col; f.handle := HandleEdit; f.rgb := rgb; Oberon.AllocateSystemViewer(Oberon.Mouse.X, x, y);
    v := MenuViewers.New(TextFrames.NewMenu("Color", Menu), f, TextFrames.menuH, x, y);
    Texts.Write(w, " "); Texts.WriteInt(w, colNr, 0); Texts.Insert(v.dsc(TextFrames.Frame).text, 5, w.buf)
  END EditColor;
  PROCEDURE Show(f: Frame);
    VAR i, r, n, w, x: INTEGER;
  BEGIN n := f.n; w := f.W DIV n; r := f.W - w * n; i := 0; x := 0; INC(w);
    WHILE i < n DO f.beg[i] := x;
      IF r = 0 THEN DEC(w) END;
      Display.ReplConst(i, f.X + x, f.Y, w, f.H, Display.replace); INC(x, w); INC(i); DEC(r)
    END
  END Show;
  PROCEDURE Edit(f: Frame; x, y: INTEGER; keys: SET);
    VAR keySum: SET; i: INTEGER;
  BEGIN keySum := keys;
    REPEAT Input.Mouse(keys, x, y); keySum := keySum + keys;
      Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, x, y)
    UNTIL keys = {};
    IF (keySum = {Left}) OR (keySum = {Right}) THEN i := 1; x := x - f.X;
      WHILE (i < f.n) & (f.beg[i] < x) DO INC(i) END;
      EditColor(i-1, keySum = {Left})
    END
  END Edit;
  PROCEDURE Handler(f: Display.Frame; VAR m: Display.FrameMsg);
    VAR frame: Frame;
  BEGIN
    WITH f: Frame DO
      IF m IS Oberon.InputMsg THEN
        WITH m: Oberon.InputMsg DO
          IF m.id = Oberon.track THEN
            IF m.keys = {} THEN Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, m.X, m.Y)
            ELSE Edit(f, m.X, m.Y, m.keys)
            END
          END
        END
      ELSIF m IS Oberon.CopyMsg THEN NEW(frame); frame^ := f^; m(Oberon.CopyMsg).F := frame
      ELSIF m IS MenuViewers.ModifyMsg THEN
        WITH m: MenuViewers.ModifyMsg DO f.Y := m.Y; f.H := m.H; Show(f) END
      END
    END
  END Handler;
  PROCEDURE Open*;
    VAR s: Texts.Scanner;  f: Frame; v: Viewers.Viewer;  x, y, n: INTEGER;
  BEGIN Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
    IF s.class = Texts.Int THEN n := SHORT(s.i) ELSE n := Cols END;
    Oberon.AllocateSystemViewer(Oberon.Mouse.X, x, y); NEW(f); f.handle := Handler; f.n := n;
    v := MenuViewers.New(TextFrames.NewMenu("Colors", Menu), f, TextFrames.menuH, x, y)
  END Open;
	PROCEDURE Scan(VAR s: Texts.Scanner);
		VAR T: Texts.Text;
             beg, end, time: LONGINT;
	BEGIN
		Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
		IF (s.class = Texts.Char) & (s.c = "^") OR (s.line # 0) THEN
			Oberon.GetSelection(T, beg, end, time);
			IF time >= 0 THEN Texts.OpenScanner(s, T, beg); Texts.Scan(s) END
		END
	END Scan;
  PROCEDURE OpenRGB*;
    VAR s: Texts.Scanner;
  BEGIN Scan(s);
    IF s.class = Texts.Int THEN EditColor(SHORT(s.i), TRUE) END
  END OpenRGB;
  PROCEDURE OpenHLS*;
    VAR s: Texts.Scanner;
  BEGIN Scan(s);
    IF s.class = Texts.Int THEN EditColor(SHORT(s.i), FALSE) END
  END OpenHLS;
  PROCEDURE Set*;
    VAR s: Texts.Scanner;  v: ARRAY 4 OF INTEGER; i: INTEGER;
  BEGIN Scan(s); i := 0;
    WHILE (s.class = Texts.Int) & (i < 4) DO v[i] := SHORT(s.i); Texts.Scan(s); INC(i) END;
    IF i = 4 THEN Display.SetColor(v[0], v[1], v[2], v[3]) END
  END Set;
  PROCEDURE Get*;
    VAR s: Texts.Scanner;  v: ARRAY 4 OF INTEGER; i: INTEGER;
  BEGIN Scan(s);
    IF s.class = Texts.Int THEN v[0] := SHORT(s.i); Display.GetColor(v[0], v[1], v[2], v[3]); i := 0;
      WHILE i < 4 DO Texts.WriteInt(w, v[i], 5); INC(i) END;
      Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf)
    END
  END Get;
    PROCEDURE Load*;
      VAR par: Oberon.ParList;
		S: Texts.Scanner;
        f: Files.File; R: Files.Rider;
        col: SHORTINT; red, green, blue: CHAR;
    BEGIN
      Texts.WriteString(w, "Colors.Load ");
	  par := Oberon.Par;
	  Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
	  IF S.class = Texts.Name THEN
        Texts.WriteString(w, S.s);
        f := Files.Old(S.s);
        IF f # NIL THEN
          Files.Set(R, f, 0); col := -1;
          REPEAT
            Files.Read(R, red); Files.Read(R, green); Files.Read(R, blue);
            Display.SetColor(col, ORD(red), ORD(green), ORD(blue));
            INC(col)
          UNTIL col = 16
        ELSE Texts.WriteString(w, " not found")
        END
      ELSE Texts.WriteString(w, " no name")
      END;
      Texts.WriteLn(w);
      Texts.Append(Oberon.Log, w.buf)
    END Load;
    PROCEDURE Store*;
      VAR par: Oberon.ParList;
		S: Texts.Scanner;
        f: Files.File; R: Files.Rider;
        col, red, green, blue: INTEGER;
    BEGIN
      Texts.WriteString(w, "Colors.Store ");
	  par := Oberon.Par;
	  Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
	  IF S.class = Texts.Name THEN
        Texts.WriteString(w, S.s);
        f := Files.New(S.s); Files.Set(R, f, 0);
        IF f # NIL THEN col := -1;
          REPEAT
           Display.GetColor(col, red, green, blue);
           Files.Write(R, CHR(red));
           Files.Write(R, CHR(green));
           Files.Write(R, CHR(blue));
           INC(col)
          UNTIL col = 16;
          Files.Register(f)
        ELSE Texts.WriteString(w, " no space")
        END
      ELSE Texts.WriteString(w, " no name")
      END;
      Texts.WriteLn(w);
      Texts.Append(Oberon.Log, w.buf)
    END Store;
  PROCEDURE* Activate;
    VAR m: Msg;
  BEGIN Viewers.Broadcast(m)
  END Activate;
BEGIN 
  Cols:=SHORT(ASH(1, Amiga.OberonDepth));
  Texts.OpenWriter(w);
  NEW(task); task.handle := Activate; task.safe := FALSE; task.time := -1; Oberon.Install(task);
  grey[0] := Display.grey0; grey[1] := Display.grey1; grey[2] := Display.grey2
END Colors.
Colors.Open
Colors.Set ^
  1 255 0 0 ~ 2 0 255 0 ~ 3 0 0 255 ~
Colors.Get ^  Colors.OpenRGB ^  Colors.OpenHLS ^
  0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15